home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / programr / wtj009.zip / VBMEM.ZIP / MEMHUGE.TXT < prev   
Text File  |  1992-08-06  |  5KB  |  194 lines
  1. Rem THE VB MEMORY LANE by Costas Kitsos
  2.  
  3. DefInt A-Z
  4.  
  5. Dim AHINCR As Integer
  6.  
  7. Sub Form_Load ()
  8.     AHINCR = GetProcAddress(GetModuleHandle("KERNEL"), "__AHINCR") And &HFFFF&
  9. End Sub
  10.  
  11. Sub Mnu_LongInteger_Click ()
  12.     
  13.     Cls
  14.  
  15.     Dim MemHandle As Integer, wSize  As Integer
  16.     Dim lpAddress As Long, dwData As Long
  17.     Dim dwIndex As Long, dwBytes As Long
  18.     
  19.     Const Max = 70000
  20.     
  21.     ' Demo a 70,000 element Array of Long Integers
  22.  
  23.     wSize = Len(dwData) ' wSize equals the size of a long Integer (4 bytes)
  24.    
  25.     MemHandle = GlobalAlloc(GHND, Max * wSize)
  26.  
  27.     If MemHandle = 0 Then Exit Sub    ' If our request failed then exit
  28.  
  29.     Print "Allocated"; Max * wSize; " bytes"
  30.     Print
  31.  
  32.     lpAddress = GlobalLock(MemHandle) ' get a pointer to the memory block
  33.  
  34.     
  35.     Print "Writing Data to" + Str$(Max) + " Element Array of Long Integers"
  36.     Print
  37.  
  38.     wSel = lpAddress \ &H10000  ' calculate the Selector portion of the Address
  39.  
  40.     For dwData = 0 To Max - 1 Step 100 ' write some data
  41.     
  42.     dwBytes = dwData * wSize
  43.     Call hmemcpy(ByVal (((wSel + (((dwBytes \ &H10000) * AHINCR))) * &H10000) + (dwBytes And &HFFFF&)), dwData, wSize)
  44.  
  45.     Next
  46.  
  47.     dwIndex = 60000
  48.  
  49.     Print "Reading Data from element:", dwIndex
  50.  
  51.      dwBytes = dwIndex * wSize
  52.      Call hmemcpy(dwData, ByVal (((wSel + (((dwBytes \ &H10000) * AHINCR))) * &H10000) + (dwBytes And &HFFFF&)), wSize)
  53.     
  54.     Print "Data in Element"; dwIndex; " = ", dwData
  55.  
  56.     Print
  57.     Print "Freeing Memory"
  58.  
  59.     Ok = GlobalUnlock(MemHandle)
  60.     Ok = GlobalFree(MemHandle)
  61.  
  62.     Print "Done"
  63.     
  64. End Sub
  65.  
  66. Sub Mnu_UserType_Click ()
  67.  
  68.     Cls
  69.  
  70.     ' Demo a User Defined Type array of 2,000 elements
  71.  
  72.     Dim StoreRec As VideoType
  73.  
  74.     RecordsSize& = 2000 * Len(StoreRec) ' 256,000 bytes
  75.     
  76.     MemHandle = GlobalAlloc(GHND, RecordsSize&)
  77.  
  78.     If MemHandle = 0 Then Exit Sub    ' If our request failed then exit
  79.  
  80.     Print "Allocated "; RecordsSize&; " bytes"
  81.     Print
  82.  
  83.     wSel = GlobalHandleToSel(MemHandle) ' get a selector
  84.  
  85.     ' some data to write
  86.  
  87.     StoreRec.Index = 8731
  88.     StoreRec.Title = "Silence of the Lambs"
  89.     StoreRec.Length = 90
  90.     StoreRec.IsRented = 1
  91.     StoreRec.Customer = "Gus Tomer"
  92.     StoreRec.CustomerNo = 33
  93.  
  94.     dwOffset& = 1999 * Len(StoreRec)
  95.     dwcb& = Len(StoreRec)
  96.  
  97.     Bytes& = MemoryWrite(wSel, dwOffset&, StoreRec, dwcb&)
  98.     
  99.     Print "Wrote:"; Bytes&; " bytes at Index 1999": Print
  100.  
  101.     ' Ready to read it back now.
  102.     
  103.     ' erase the record to prove that it worked.
  104.     StoreRec.Index = 0
  105.     StoreRec.Title = ""
  106.     StoreRec.Length = 0
  107.     StoreRec.IsRented = 0
  108.     StoreRec.Customer = ""
  109.     StoreRec.CustomerNo = 0
  110.     
  111.     ' read the record
  112.  
  113.     Bytes& = MemoryRead(wSel, dwOffset&, StoreRec, dwcb&)
  114.  
  115.     Print "Read:"; Bytes&; " bytes at index 1999": Print
  116.  
  117.     Print "StoreRec.Index = "; StoreRec.Index
  118.     Print "StoreRec.Title = "; StoreRec.Title
  119.     Print "StoreRec.Length = "; StoreRec.Length
  120.     Print "StoreRec.IsRented = "; StoreRec.IsRented
  121.     Print "StoreRec.Customer = "; StoreRec.Customer
  122.     Print "StoreRec.CustomerNo = "; StoreRec.CustomerNo
  123.     Print
  124.  
  125.     Ok = GlobalFree(MemHandle)
  126.  
  127.     Print "Done"
  128.  
  129. End Sub
  130.  
  131. Sub Mnu_TimeTest_Click ()
  132.     
  133.     Cls
  134.  
  135.     Dim MemHandle As Integer, wSize As Integer
  136.     Dim lpAddress As Long, dwIndex As Long
  137.     Dim dwData As Long, dwBytes As Long
  138.     
  139.     Const Max = 100000
  140.     ' Demo a 100,000 element Array of Long Integers
  141.  
  142.     wSize = Len(dwData)        ' wSize equals the size of a long integer (4 bytes)
  143.    
  144.     MemHandle = GlobalAlloc(GHND, (Max * wSize))
  145.  
  146.     If MemHandle = 0 Then Exit Sub      ' If our request failed then exit
  147.  
  148.     Print "Allocated"; Max * wSize; " bytes"
  149.     Print
  150.  
  151.     lpAddress = GlobalLock(MemHandle)   ' get a pointer to the memory block
  152.  
  153.     Print "Writing Data with hmemcpy to" + Str$(Max) + " Element Array of Long Integers"
  154.  
  155.     StartTime& = GetTickCount()
  156.  
  157.     wSel = lpAddress \ &H10000  ' calculate the Selector portion of the Address
  158.  
  159.     For dwData = 0 To Max - 1 Step 50
  160.     
  161.     dwBytes = dwData * wSize
  162.     Call hmemcpy(ByVal (((wSel + (((dwBytes \ &H10000) * AHINCR))) * &H10000) + (dwBytes And &HFFFF&)), dwData, wSize)
  163.  
  164.     Next
  165.  
  166.     EndTime& = GetTickCount()
  167.  
  168.     Print "hmemcpy Time = "; Str$(EndTime& - StartTime&); " milliseconds"
  169.     Print
  170.     Print "Writing Data with ToolHelp to" + Str$(Max) + " Element Array of Long Integers"
  171.  
  172.     wSel = GlobalHandleToSel(MemHandle)
  173.  
  174.     StartTime& = GetTickCount()
  175.  
  176.     For dwData = 0 To Max - 1 Step 50
  177.     
  178.     dwBytes = MemoryWrite(wSel, wSize * dwData, dwData, wSize)
  179.     
  180.     Next
  181.  
  182.     EndTime& = GetTickCount()
  183.  
  184.     Print "ToolHelp Time = "; Str$(EndTime& - StartTime&); " milliseconds"
  185.     
  186.     Ok% = GlobalUnlock(MemHandle)
  187.     Ok% = GlobalFree(MemHandle)
  188.  
  189.     Print
  190.     Print "Done"
  191.  
  192. End Sub
  193.  
  194.